perm filename PUTCH[AI,JMC] blob
sn#005446 filedate 1971-08-13 generic text, type T, neo UTF8
00100 TITLE PUTCH
00200
00300 ;AC ASSIGNMENTS
00400 P=17 ;PUSHDOWN LIST
00500 MOVER=16 ;PIECE TO BE MOVED
00600 DEST=15 ;DESTINATION OF PIECE
00700 I=14 ;AN INDEX VARIABLE
00800 OLD=13 ;OLD LOCATION OF MOVING PIECE
00900 MDIR=12 ;IN GENERAL A MULTIPLE OF DIR TO SAVE TIME
01000 DIR=11 ;AN INDEX BY DIRECTION
01100 IBEAR=10 ;INDEX VARIABLE FOR BEARINGS
01200 B=7 ;SIMILAR
01300 K=6 ;OFTEN HOLDS KIND OF SOME PIECE
01400 M=5 ;INDEX VARIABLE
01500 N=4 ;USUALLY ASSOCIATED WITH NEXT SQUARE CONSIDERED
01600 T2=3 ;TEMP CELL
01700 T1=2 ;ANOTHER TEMP CELL
01800
01900 ;ACS 0,1 NOT USED BY PUTCH
02000
02100 ;PEICE KINDS
02200 PAWN=0
02250 ROOK=1
02300 KNIGHT=2
02400 BISHOP=3
02500 QUEEN=4
02600 KING=5
02700
02800 ;DESCRIPTION OF TABLES USED
02900 ;NEXT THIS TABLE INDEXED BY DIRECTION AND SQUARE GIVES NEXT
03000 ; SQUARE IN THAT DIRECTION -1 MEANS OFF BOARD
03050 ; LEFT HALF HAS MDIR IN INDEX FIELD FOR MAGIC
03100
03200 ;LOC INDEXED BY PIECE GIVES LOCATION OF PIECE
03250 ; -1 MEANS OFF BOARD
03300
03400 ;OCC INDEXED BY SQUARE GIVES OCCUPANT OF SQUARE
03500 ; -1 MEANS NOT OCCUPIED
03600
03700 ;JBEAR INDEXED BY DIRECTION AND SQUARE GIVES PIECE BEARING
03800 ; ON THAT SQUARE FROM THAT DIRECTION. -1 MEANS NONE
03900
04000 ;KDIR: INDEXED BY COLOR AND SQUARE GIVES DIRECTION FROM
04100 ; WHICH KING OF THAT COLOR BEARS UPON SQUARE -1 MEANS
04200 ; KING DOES NOT BEAR ON SQUARE
00100 ;MOVE TABLE OF MOVES INDEXED BY PIECE, DIRECTION, AND DISTANCE
00200 ; GIVES PSEUDO MOVE (IN FORM DIRECTION*100+DEST)
00300 ; -1 MEANS NO MOVE. HOWEVER PAWN MOVES ARE FIRST 4
00400 ; ENTRIES IN PAWN BLOCK AND KNIGHTS FIRST 10
00500
00600 ;KIND INDEXED BY PIECE GIVES KIND OF THAT PIECE
00700
00800 ;VALUE INDEXED BY KIND OF PIECE GIVES VALUE
00900
01000 ;RANK INDEXED BY SQUARE GIVES ITS RANK
01100
01200 ;FILE SAME FOR ITS FILE
01300
01400 ;OPP INDEXED BY DIRECTION GIVES OPPOSITE DIRECTION
01500
01600 ;LM LEFT HALF IS -NUMBER OF POSSIBLE ENTRIES IN MOVE TABLE
01700 ; RIGHT HALF START OF PIECES BLOCK IN MOVE TABLE
01800 ; EXCEPT PAWN AND KNIGHTS WHERE LEFT HALF IS 3 OR 7
01900 ; RESPECTIVELY
02000
02100 ;DISTBL INDEXED BY SQUARES TO GIVE DISTANCE NEED AN
02200 ; LDB AC,DISTBL(SQ1) WHERE SQ1 IS FIRST SQUARE AND
02300 ; T1 IS SECOND SQUARE LOADS AC WITH DISTANCE
02400 ; BETWEEN SQ1 AND T1
02500
02600 ;EIGHTX INDEX BY DIRECTION GIVES DIRECTION TIMES 10
02700
02800 ;PIECES NUMBERED 0 TO 37. WHITE IS 0 TO 17, BLACK 20 TO 37
02900 ;BOARD SQUARES NUMBERED 0 TO 77
03000 ;DIRECTIONS AS FOLLOWES
03100
03200 ; 10 11
03300 ; 17 4 1 5 12
03400 ; 0 2
03500 ; 16 7 3 6 13
03600 ; 15 14
03700
03800 ;VIEWED FROM WHITE'S SIDE OF THE BOARD
03900
04000 ;WARNING: ALL NUMBERS IN THIS PROGRAM ARE IN OCTAL!!!!!!
00100 PUTCH: SKIPGE OLD,LOC(MOVER) ;LOAD OLD AND CHECK IF
00200 ;COMMING FROM OFF BOARD
00300 JRST L11A ;YES FROM OFF BOARD
00400 MOVNI T2,1 ;NO, READY TO ERASE OLD MOVES AND
00500 ;BEARINGS. SET T2 TO -1 FOR THIS
00600 SKIPL I,LM(MOVER) ;GET POINTER TO MOVE TABLE
00700 JRST L11P ;PAWNS AND KNIGHTS HAVE POS. ENTRIES
00800 HLRE M,I ;NOT A PAWN OR KNIGHT. SET UP M
00900 ;WITH NUMBER OF DIRECTIONS TO CHECK
01000 JRST PL4 ;GO DO IT
01100 L11P: TLC I,-1 ;DO PAWNS, KNIGHTS SET LEFT OF I TO
01200 ;-NUMBER OF LOCATIONS TO ERASE
01300 SKIPGE T1,MOVE(I) ;GET THIS MOVE
01400 JRST L11PA ;NO MOVE TO ERASE
01500 MOVEM T2,MOVE(I) ;ERASE IT
01600 MOVEM T2,JBEAR(T1) ;AND ALSO ASSOCIATED BEARING
01700 L11PA: AOBJN I,L11P+1 ;GO DO MORE
01800 JRST L11A ;ALL DONE
01900 PL2: ADDI I,10 ;SET UP FOR NEXT DIRECTION
02000 ANDI I,-10 ;WHICH IS A MULTIPLE OF 10
02100 PL4: SKIPGE T1,MOVE(I) ;GET THIS MOVE
02200 JRST PL3 ;NO MOVE THERE, MUST BE END OF DIRECTION
02300 PL1: MOVEM T2,JBEAR(T1) ;ERASE BEARING
02400 MOVEM T2,MOVE(I) ;AND MOVE
02500 SKIPL T1,MOVE+1(I) ;ANOTHER MOVE AROUND?
02600 AOJA I,PL1 ;YES DO IT
02700 PL3: AOJL M,PL2 ;NO, TRY NEW DIRECTION
02800 L11A: MOVEM DEST,LOC(MOVER) ;OLD MOVES ALL ERASED
02900 ;UPDATE LOC TABLE
03000 SETOM OCC(OLD) ;SET OLD SQUARE UNOCCUPIED
03100 SKIPL DEST ;MOVING OFF BOARD?
03200 MOVEM MOVER,OCC(DEST) ;NO, SO OCCUPY NEW SQUARE
03300 JUMPGE OLD,L21 ;NEXT CODE ONLY IF CAME FROM OFF BOARD
03400 MOVE T1,KIND(MOVER) ;UPDATING MATERIAL BALACNE
03500 MOVE T1,VALUE(T1)
03600 CAIGE MOVER,20 ;WHOSE PIECE
03700 ADDM T1,WCOUNT# ;WHITE
03800 CAIL MOVER,20
03900 ADDM T1,BCOUNT# ;OR BLACK
04000 JRST P1 ;FROM OFF BOARD NEXT CODE NOT NEEDED
00100 ;UPDATE MOVES OF PIECES THAT USED TO BEAR ON MOVING PIECE
00200
00300 L21: MOVEI MDIR,0 ;START AT DIRECTION 0 MDIR=DIR*100
00400 HRLZI DIR,-10 ;CHECK FIRST 10 DIRECTIONS
00500 MOVE IBEAR,OLD ;INDEX INTO JBEAR
00600 L24: SKIPGE B,JBEAR(IBEAR) ;GET PIECE BEARING HERE
00700 JRST PD1 ;THERE ISN'T ONE
00800 MOVE K,KIND(B) ;GET KIND OF PIECE
00900 CAIN K,PAWN ;IS IT PAWN
01000 JRST PD2 ;PAWNS ARE SPECIAL
01100 SKIPGE N,NEXT(IBEAR) ;GET NEXT SQUARE IN THAT DIR.
01200 JRST PD1 ;NO MORE IN THAT DIR.
01300 MOVE T1,LOC(B) ;GET LOCATION OF BEARING PIECE
01400 LDB M,DISTBL(OLD) ;GET DISTANCE TO NEW SQUARE
01500 ADD M,EIGHTX(DIR) ;SETTING UP MOVE TABLE ENTRY
01600 ;LM(MOVER)+10*DIR+DISTANCE
01700 ADD M,LM(B)
01800 PD3: MOVEI T1,@N ;SINCE LEFT HALF OF NEXT WHICH LOADED
01900 ;N HAS MDIR IN INDEX FIELD THIS GIVES
02000 ;N+MDIR WHICH IS CORRECT INDEX INTO JBEAR
02100 MOVEM B,JBEAR(T1) ;ENTER BEARING
02200 HRRZM T1,MOVE(M) ;INDEX IS ALSO IN FORM OF MOVE
02300 ;SO ENTER IT
02400 CAIE K,KING ;FOR KINGS UPDATE KDIR
02500 JRST L25 ;ELSE SKIP THIS
02600 MOVE T2,OPP(DIR) ;GET OPPOSITE DIRECTION
02700 MOVE I,N ;START GENERATING INDEX TO KDIR
02800 CAIL B,20 WHICH COLOR
02900 IORI I,100 SET CORRECT INDEX
03000 MOVEM T2,KDIR(I) ;STORE
03100 L25: SKIPL OCC(N) ;WAS THERE A PIECE THERE
03200 JRST PD1 ;IF YES, STOP UPDATING THIS DIR.
03300 SKIPGE N,NEXT(T1) ;GET NEXT SQUARE
03400 JRST PD1 ;OFF BOARD
03500 AOJA M,PD3 ;UPDATE IT (CHANGE POINTER TO MOVE TABLE)
00100 PD2: MOVE T1,RANK(OLD) ;HERE BE PAWNS
00200 CAIGE B,20 ;SPECIAL CHECKING FOR POSSIBILITY
00300 ;OF MOVING 2 FORWARD ON FIRST MOVE
00400 JRST L31 ;DO A BLACK PAWN
00500 CAIN T1,5 ;ON RANK 5
00600 CAIE MDIR,300 ;DIRECTION 3
00700 JRST PD1 ;NO UPDATE NOT NECESSARY
00800 JRST L32 ;NECESSARY TO CHECK UPDATE
00900 L31: CAIN T1,2 ;RAND 2?
01000 CAIE MDIR,100 ;AND DIR 1
01100 JRST PD1 ;NO, DON'T UPDATE
01200 L32: MOVE T1,IBEAR ;GET BEARING TABLE INDEX
01300 CAIGE B,20 ;ONE SQUARE IN EITHER DIR. DEPENDING ON COLOR
01400 ADDI T1,10
01500 CAIL B,20
01600 SUBI T1,10
01700 MOVEM B,JBEAR(T1) ;UPDATE BEARING
01800 MOVE T2,LM(B) ;WANT TO UPDATE MOVE TABLE TOO
01900 HRRZM T1,MOVE+3(T2) ;ALWAYS 4TH ENTRY
02000 PD1: ;READY TO UPDATE NEXT DIR.
02100 ADDI MDIR,100 ;DIR INCREASE BY 1 SO THIS BY 100
02200 ADDI IBEAR,100 ;SAME HERE
02300 AOBJN DIR,L24 ;NEXT DIRECTION IF ANY LEFT
02400 JUMPGE DEST,P1 ;ALL DONE HERE. NEXT CODE IF MOVING
02500 ;OFF OF BOARD
02600 ;UPDATE MATERIAL SAME AS BEFORE
02700 MOVE T1,KIND(MOVER)
02800 MOVN T1,VALUE(T1) ;BUT THIS TIME SUBTRACT
02900 CAIGE MOVER,20
03000 ADDM T1,WCOUNT ;BY ADDING NEGATIVE
03100 CAIL MOVER,20
03200 ADDM T1,BCOUNT
03300 POPJ P, ;IF GOING OFF BOARD DONE AT THIS POINT
00100 ;FOLLOWING CODE ALMOST EXACTLY SAME AS L21 SO NO COMMENTS
00200 ;THIS REMOVES BEARINGS AND MOVES MADE INVALID
00300
00400 P1: MOVEI MDIR,0
00500 HRLZI DIR,-10
00600 MOVE IBEAR,DEST
00700 L44: SKIPGE B,JBEAR(IBEAR)
00800 JRST PE1
00900 MOVE K,KIND(B)
01000 CAIN K,PAWN
01100 JRST PE2
01200 SKIPGE N,NEXT(IBEAR)
01300 JRST PE1
01400 MOVE T1,LOC(B)
01500 LDB M,DISTBL(DEST)
01600 ADD M,EIGHTX(DIR)
01700 ADD M,LM(B)
01800 PE3: MOVEI T1,@N
01900 SETOM JBEAR(T1)
02000 SETOM MOVE(M)
02100 CAIE K,KING
02200 JRST L45
02300 MOVE T2,N
02400 CAIL B,20
02500 IORI T2,100
02600 SETOM KDIR(T2)
02700 L45: SKIPL OCC(N)
02800 JRST PE1
02900 SKIPGE N,NEXT(T1)
03000 JRST PE1
03100 AOJA M,PE3
03200 PE2: MOVE T1,RANK(DEST)
03300 CAIGE B,20
03400 JRST L51
03500 CAIN T1,5
03600 CAIE MDIR,300
03700 JRST PE1
03800 JRST L52
03900 L51: CAIN T1,2
04000 CAIE MDIR,100
04100 JRST PE1
00100 L52: MOVE T1,IBEAR
00200 CAIGE B,20
00300 ADDI T1,10
00400 CAIL B,20
00500 SUBI T1,10
00600 SETOM JBEAR(T1)
00700 MOVE T2,LM(B)
00800 SETOM MOVE+3(T2)
00900 PE1: ADDI MDIR,100
01000 ADDI IBEAR,100
01100 AOBJN DIR,L44
01200
01300 ;HERE IS WHERE WE PUT IN THE MOVES AND BEARINGS OF THE
01400 ;MOVED PIECE FROM ITS MOVED POSITION
01500
01600 MOVE K,KIND(MOVER) ;GET THE KIND OF PIECE
01700 XCT TB1(K) ;SOMETIMES A JUMP OTHERS A MOVE
01800 ; THIS SECTION HANDLES ALL BUT PAWNS AND KNIGHTS
01900 PFRB5: HRRZ MDIR,DIR ;DIR WAS LOADED BY THE EXECUTE
02000 ;OR THE SPECIAL KING ROUTINE
02100 LSH MDIR,6 ;MULTIPLY BY 100
02200 PFRB4: HRRZ M,DIR ;GET THE DIRECTION
02300 LSH M,3 ;TIMES 10
02400 ADD M,LM(MOVER) ;A POINTER TO MOVE TABLE
02500 MOVE N,DEST ;SETTING UP POINTER TO SQUARE
02600 HRLI N,MDIR ;MAKE IT LOOK LIKE LOADED FROM NEXT
02700 MOVE T1,MDIR ;CREATE POINTER TO NEXT TABLE
02800 IOR T1,N ;THE REST OF IT
02900 PFRB3: SKIPGE N,NEXT(T1) ;GET THE NEXT SQUARE
03000 JRST PF1 ;OFF THE BOARD
03100 MOVEI T1,@N ;THE SAME TRICK FOR N+MDIR
03200 MOVEM MOVER,JBEAR(T1) ;UPDATE BEARINGS
03300 HRRZM T1,MOVE(M) ;AND MOVE TABLE
03400 CAIE K,KING
03500 JRST PFRB2
03600 MOVE I,N ;IF KING ALSO UPDATE KDIR
03700 CAIL MOVER,20
03800 IORI I,100
03900 MOVE T2,OPP(DIR)
04000 MOVEM T2,KDIR(I)
04100 PFRB2: SKIPGE OCC(N) ;IS IT OCCUPIED
04200 AOJA M,PFRB3 ;NO NEXT MOVE
04300 PF1: ADDI MDIR,100 ;GO TO NEXT DIRECTION
04400 AOBJN DIR,PFRB4 ;IF ANY LEFT
04500 POPJ P, ;IF NONE LEFT, EXIT
04600
00100 ;HERE IS THE TABLE OF THINGS EXECUTED
00200 TB1: JRST PFP ;FOR PAWNS
00300 HRLZI DIR,-4 ;FIRST 4 DIRECTIONS FOR ROOKS
00400 JRST PFN ;DO KNIGHTS
00500 MOVE DIR,[XWD -4,4] ;DIR 4-7 FOR BISHOPS
00600 HRLZI DIR,-10 ;10 DIRECTIONS FOR QUEEN
00700 JRST KSET ;SPECIAL KING ROUTINE
00800 KSET: CAIGE MOVER,20 ;THIS ZEROS KDIR
00900 JRST KS1
01000 MOVE DIR,[XWD KDIR+100,KDIR+101] ;SET FOR BLT
01100 SETOM KDIR+100 ;WOULD YOU BELIEVE -1 INSTEAD OF 0
01200 BLT DIR,KDIR+177 ;SET ALL FOR THIS COLOR
01300 HRLZI DIR,-10 ;ALL DIRECTIONS FOR KING
01400 JRST PFRB5 ;GO DO IT
01500 KS1: MOVE DIR,[XWD KDIR,KDIR+1] ;SAME BUT FOR OTHER KING
01600 SETOM KDIR
01700 BLT DIR,KDIR+77
01800 HRLZI DIR,-10
01900 JRST PFRB5
02000
02100 ;HERE FOR KNIGHTS
02200 PFN: MOVE DIR,[XWD -10,10] ;DIRS 10-17
02300 MOVE MDIR,DEST
02400 IORI MDIR,1000 ;SET UP MDIR
02500 PFN2: SKIPGE N,NEXT(MDIR) ;GET SQUARE IN THAT DIR
02600 JRST PFN1 ;OFF BOARD
02700 MOVE T1,DIR ;GET THE DIRECTION
02800 LSH T1,6 ;TIMES 100
02900 IOR T1,N ;PUT IN SQUARE
03000 MOVEM MOVER,JBEAR(T1) ;SET UP BEARINGS
03100 MOVEI T2,-10(DIR) ;MAGIC FOR POINTER TO MOVE TABLE
03200 ADD T2,LM(MOVER)
03300 HRRZM T1,MOVE(T2) ;PUT IN MOVE
03400 PFN1: ADDI MDIR,100 ;NEXT DIRECTION
03500 AOBJN DIR,PFN2 ;IF THERE IS ONE
03600 POPJ P, ;ELSE EXIT
00100 ;HERE ARE PAWNS, THEY ARE RATHER HORRIBLE
00200
00300 PFP: MOVE M,LM(MOVER) ;POINTER TO MOVE TABLE
00400 CAIL MOVER,20 ;WHICH COLOR?
00500 JRST BLACKP
00600 MOVEI DIR,400 ;DIRECTION 4 FIRST
00700 IOR DIR,DEST ;CURRENT SQUARE
00800 SKIPGE N,NEXT(DIR) ;GET NEXT
00900 JRST PF3 ;OFF BOARD, TRY NEXT DIR
01000 IORI N,400 ;PUT IN DIRECTION
01100 MOVEM MOVER,JBEAR(N) ;PUT IN BEARINGS
01200 HRRZM N,MOVE(M) ;AND MOVE
01300 PF3: SKIPGE N,NEXT+100(DIR) ;SIMILAR FOR DIR 5
01400 JRST PF3P
01500 IORI N,500
01600 MOVEM MOVER,JBEAR(N)
01700 HRRZM N,MOVE+1(M) ;ALWAYS SECOND LOCATION IN BLOCK
01800 PF3P: MOVE IBEAR,DEST ;NOW FOR DIR 1
01900 ADDI IBEAR,110 ;PUT IN DIRECTION AND DO NEXT AT SAME TIME
02000 MOVEM MOVER,JBEAR(IBEAR) ;PUT IN BEARING
02100 HRRZM IBEAR,MOVE+2(M) ;AND MOVE
02200 MOVE T1,RANK(DEST) ;CHECKING TO SEE IF COULD
02300 CAIN T1,1 ;MOVE FORWARD 2
02400 SKIPL OCC+10(DEST) ;MAYBE SOMEONE IN WAY
02500 POPJ P, ;CAN NOT MOVE 2
02600 ADDI IBEAR,10 ;YES WE CAN
02700 MOVEM MOVER,JBEAR(IBEAR) ;SET UP BEARING
02800 HRRZM IBEAR,MOVE+3(M) ;AND MOVE
02900 POPJ P, ;AND EXIT
03000 BLACKP: MOVEI DIR,600 ;BLACP PAWNS ARE SIMILAR
03100 IOR DIR,DEST
03200 SKIPGE N,NEXT(DIR)
03300 JRST PF4
03400 IORI N,600
03500 MOVEM MOVER,JBEAR(N)
03600 HRRZM N,MOVE(M)
03700 PF4: SKIPGE N,NEXT+100(DIR)
03800 JRST PF4P
03900 IORI N,700
04000 MOVEM MOVER,JBEAR(N)
04100 HRRZM N,MOVE+1(M)
00100 PF4P: MOVE IBEAR,DEST
00200 ADDI IBEAR,270
00300 MOVEM MOVER,JBEAR(IBEAR)
00400 HRRZM IBEAR,MOVE+2(M)
00500 MOVE T1,RANK(DEST)
00600 CAIN T1,6
00700 SKIPL OCC-10(DEST)
00800 POPJ P,
00900 SUBI IBEAR,10
01000 MOVEM MOVER,JBEAR(IBEAR)
01100 HRRZM IBEAR,MOVE+3(M)
01200 POPJ P,
00100 ;HERE ARE THE TABLES
00200
00300 NEXT: BLOCK 2000
00400 LOC: BLOCK 41 ;OCC NEEDS A -1 POSITION
00500 OCC: BLOCK 100
00600 JBEAR: BLOCK 2000
00700 KDIR: BLOCK 200
00800 MOVE: BLOCK 4000
00900 KIND: REPEAT 2,<EXP 1,2,3,4,5,3,2,1
01000 REPEAT 10,<Z>>
01100 VALUE: EXP 1,2,3,4,5,6
01200 RANK: FOO=0
01300 REPEAT 10,<REPEAT 10,<EXP FOO>
01400 FOO=FOO+1>
01500 FILE: REPEAT 10,<EXP 0,1,2,3,4,5,6,7>
01600 OPP: EXP 2,3,0,1,6,7,4,5,14,15,16,17,10,11,12,13
01700 LM: FOO=0
01800 REPEAT 2,<XWD -10,FOO
01900 FOO=FOO+100
02000 XWD 7,FOO
02100 FOO=FOO+100
02200 REPEAT 4,<XWD -10,FOO
02300 FOO=FOO+100>
02400 XWD 7,FOO
02500 FOO=FOO+100
02600 XWD -10,FOO
02700 FOO=FOO+100
02800 REPEAT 10,<XWD 3,FOO
02900 FOO=FOO+100>>
03000 EIGHTX: EXP 0,10,20,30,40,50,60,70,100,110,120,130,140,150,160,170,200
03100 DISTBL: FOO=0
03200 REPEAT 5,<X=2
03300 REPEAT 14,<POINT 3,BTB+FOO(T1),X
03400 X=X+3>
03500 FOO=FOO+100>
03600 X=2
03700 REPEAT 4,<POINT 3,BTB+500(T1),X
03800 X=X+3>
03900 BTB: BLOCK 600
00100 ;MAGIC ROUTINES TO SET UP NEXT AND BTB
00200
00300 SETBTB: MOVEI T1,77
00400 MOVEI T2,77
00500 MOVE 1,RANK(T1)
00600 CAMN 1,RANK(T2) ;IF RANKS SAME DISTANCE IS DIFF OF FILES
00700 JRST L22
00800 SUB 1,RANK(T2) ;ELSE DIFF OF RANKS SINCE HORIZ
00900 JRST L23 ;VERT. OR DIAGONAL
01000 L22: MOVE 1,FILE(T1)
01100 SUB 1,FILE(T2)
01200 L23: MOVMS 1 ;GET MAGNITUDE
01300 DPB 1,DISTBL(T2) ;PUT IN PLACE
01400 SOJGE T2,SETBTB+2 ;REPEAT
01500 SOJGE T1,SETBTB+1 ;FOR ALL PAIRS OF SQUARES
01600 POPJ P, ;EXIT
01700
01800 ;SET UP NEXT
01900 NXTSET: MOVEI I,0 ;INDEX TO NEXT TABLE
02000 HRLZI N,-20 ;DIRECTIONS
02100 NXS3: HLRE T1,TBST(N) ;Y DIF FOR THIS DIR
02200 HRRE T2,TBST(N) ;X DIF
02300 HRLZI K,-10 ;Y LOCATION
02400 NXS2: HRLZI B,-10 ;X LOCATION
02500 NXS1: HRRZ 0,B ;GET X COORDINATE
02600 ADD 0,T2 ;ADD X CHANGE
02700 JUMPL 0,NG ;NEGATIVE IS OFF BOARD
02800 CAILE 0,7
02900 JRST NG ;SO IS GREATER THAN 7
03000 HRRZ DIR,K ;SAME FOR Y
03100 ADD DIR,T1
03200 JUMPL DIR,NG
03300 CAILE DIR,7
03400 JRST NG
03500 LSH DIR,3 ;MAKE IT A SQUARE BY SQ=Y*10+X
03600 IOR DIR
03700 HRLI MDIR ;PUT IN THE MAGIC MDIR
03800 MOVEM 0,NEXT(I) ;PUT IN TABLE
03900 NXS4: ADDI I,1 ;NEXT ENTRY
04000 AOBJN B,NXS1
04100 AOBJN K,NXS2
04200 AOBJN N,NXS3
04300 POPJ P, ;ALL DONE
04400 NG: SETOM NEXT(I) ;ENTER OFF THE BOARD
04500 JRST NXS4 ;DO REST
04600 TBST: BYTE (18) 0,-1,1,0,0,1,-1,0,1,-1,1,1,-1,1,-1,-1
04700 BYTE (18) 2,-1,2,1,1,2,-1,2,-2,1,-2,-1,-1,-2,1,-2